perm filename MLIST.F4[CMS,LCS]1 blob sn#081715 filedate 1974-01-17 generic text, type T, neo UTF8
00100		COMMON JA
00200		DIMENSION JA(10,200),JB(6,200),JC(6,200),JD(6,200),NA(10)
00300	102	U=0
00400	8	K=0
00500		NB=0
00600	 	TYPE 6
00700	6	FORMAT(' NEW FILE OR OLD?'/)	
00800		ACCEPT 10,M
00900		IF(M.EQ.' '.AND.U.EQ.1)GO TO 43
01000	  	TYPE 22
01100	22	FORMAT(' TYPE A FILE NAME UP TO 5 LETTERS LONG.'/)
01200		ACCEPT 23,F
01300	23	FORMAT(A5)
01400		IF(M.EQ.'O')GO TO 43
01500	10	FORMAT(A1)
01600	15	TYPE 7
01700	7	FORMAT(' TYPE:NAME ON LINE 1,ADDRESS ON LINES 2 AND 3,'/
01800	 	1 ' AND UP TO 6 ONE LETTER LIST NAMES ON LINE 4.'/)
01900		NB=1
02000	2	K=K+1
02100	  	TYPE 3
02200	3	FORMAT(' IF FINISHED TYPE <CR>.'/)
02300		ACCEPT 9,(JA(I,K),I=1,10)
02400	9	FORMAT(7A1,3A5)
02500		IF(JA(1,K).EQ.' ')GO TO 33
02600		ACCEPT 11,(JB(I,K),I=1,6)
02700	11	FORMAT(2A1,4A5)
02800		ACCEPT 11,(JC(I,K),I=1,6)
02900		ACCEPT 20,(JD(I,K),I=1,6)
03000	20   	FORMAT(6A1)
03100		GO TO 2
03200	43	IF(LOOKD(F))GO TO 44
03300	    	TYPE 58,F
03400	58	FORMAT(1XA5,' FILE NOT FOUND.'/)
03500		GO TO 102
03600	44	REWIND 1
03700		CALL IFILE(1,F)
03800		READ(1)K,((JB(I,L),I=1,6),L=1,K)
03900		READ(1)((JA(I,L),I=1,10),L=1,K)
04000		READ(1)((JC(I,L),I=1,6),L=1,K)
04100		READ(1)((JD(I,L),I=1,6),L=1,K),K
04200	134	TYPE 66
04300	66	FORMAT(' TYPE ADD,CHANGE,DELEAT OR <CR> FOR PRINTOUT.'/)
04400		ACCEPT 10,P
04500		IF(P.EQ.'A')GO TO 15
04600		IF(P.NE.'C'.AND.P.NE.'D')GO TO 146
04700	110	TYPE 111
04800	111	FORMAT(' TYPE NAME OR IF FINISHED TYPE <CR>.'/)
04900		ACCEPT 9,(NA(I),I=1,10)
05000		IF(NA(1).EQ.' ')GO TO 134
05100		DO 114 N=1,K
05200		J=0
05300		DO 114 I=1,10
05400		IF(JA(I,N).EQ.NA(I))J=J+1
05500		IF(J.EQ.10)GO TO 148
05600	114	CONTINUE
05700		TYPE 116
05800	116	FORMAT(' NAME NOT FOUND.'/)
05900		GO TO 134
06000	148	IF(P.EQ.'D')GO TO 149
06100		NB=1
06200	   	TYPE 117
06300	117	FORMAT(' TYPE NEW NAME OR <CR> FOR NO CHANGE.'/)
06400		ACCEPT 9,(NA(I),I=1,10)
06500		IF(NA(1).EQ.' ')GO TO 119
06600		DO 131 I=1,10
06700	131	JA(I,N)=NA(I)
06800	119	TYPE 136,(JB(I,N),I=1,6)
06900		TYPE 121
07000	121	FORMAT(' TYPE NEW ADDRESS LINE OR <CR> FOR NO CHANGE.'/)
07100		ACCEPT 11,(NA(I),I=1,6)
07200	136	FORMAT(1X2A1,4A5)
07300		IF(NA(1).EQ.' ')GO TO 122
07400		DO 123 I=1,6
07500	123	JB(I,N)=NA(I)
07600	122	TYPE 136,(JC(I,N),I=1,6)
07700		TYPE 121
07800		ACCEPT 11,(NA(I),I=1,6)
07900		IF(NA(1).EQ.' ')GO TO 124
08000		DO 125 I=1,6
08100	125	JC(I,N)=NA(I)
08200	124	TYPE 137,(JD(I,N),I=1,6)
08300	137	FORMAT(1X6A1)
08400		TYPE 127
08500	127	FORMAT(' TYPE NEW LIST NAMES OR <CR> FOR NO CHANGE.'/)
08600		ACCEPT 20,(NA(I),I=1,6)
08700		IF(NA(1).EQ.' ')GO TO 134
08800		DO 129 I=1,6
08900	129	JD(I,N)=NA(I)	
09000		GO TO 134
09100	33	K=K-1
09200	   	P=' '
09300	146	IF(NB.EQ.0)GO TO 132
09400	104	DO 5 N=1,K-1
09500		IF(LN(N).LE.LN(N+1))GO TO 5
09600		DO 27 I=1,10
09700	27	JA(I,K+1)=JA(I,N)
09800		DO 133 I=1,6
09900		JB(I,K+1)=JB(I,N)
10000	  	JC(I,K+1)=JC(I,N)
10100	133	JD(I,K+1)=JD(I,N)
10200	149	DO 82 J=N,K
10300		DO 26 I=1,10
10400	26	JA(I,J)=JA(I,J+1)
10500		DO 47 I=1,6
10600		JB(I,J)=JB(I,J+1)
10700	  	JC(I,J)=JC(I,J+1)
10800	47	JD(I,J)=JD(I,J+1)
10900	82	CONTINUE
11000		IF(P.NE.'D')GO TO 104
11100		K=K-1
11200		NB=NB+NB
11300		GO TO 134
11400	5	CONTINUE
11500	132	REWIND 1
11600		CALL OFILE(1,F)
11700		WRITE(1)K,((JB(I,L),I=1,6),L=1,K),K
11800		WRITE(1)((JA(I,L),I=1,10),L=1,K),K
11900		WRITE(1)((JC(I,L),I=1,6),L=1,K),K
12000		WRITE(1)((JD(I,L),I=1,6),L=1,K),K,K
12100		END FILE 1
12200	60	TYPE 77
12300	77	FORMAT(' TYPE LIST NAME OR <CR> FOR ALL LISTS.'/)
12400		ACCEPT 10,JE
12500		Y=' '
12600	 	IF(JE.EQ.' ')GO TO 53
12700		N=1
12800		DO 99 L=1,K
12900		DO 97 I=1,6
13000		IF(JD(I,L).EQ.JE)GO TO 98
13100	97	CONTINUE
13200		GO TO 99
13300	98	DO 51 M=1,10
13400	51	JA(M,N)=JA(M,L)
13500		DO 100 M=1,6
13600		JB(M,N)=JB(M,L)
13700	   	JC(M,N)=JC(M,L)
13800	100	JD(M,N)=JD(M,L)
13900		N=N+1
14000	99	CONTINUE
14100		K=N
14200	53	Y='Y'
14300	  	TYPE 13
14400	13	FORMAT(' TTY OR LINE PRINTER?'/)
14500		ACCEPT 10,T
14600		IF(T.NE.'L')GO TO 103
14700	  	TYPE 88
14800	88	FORMAT(' PRINT WITH LIST NAMES?'/)
14900		ACCEPT 10,Y
15000	103	LIST=5
15100		IF(T.EQ.'L')LIST=3
15200		WRITE(LIST,91)F,JE
15300	91	FORMAT(//28XA5,' FILE',4XA1,' LIST')
15400		ID=2
15500		DO 45 J=1,K,3
15600		IF(K-(J-1).LT.3)ID=MOD(K,3)-1
15700		WRITE(LIST,19)((JA(I,L),I=1,10),L=J,J+ID)
15800	19	FORMAT(//3(2X7A1,3A5))
15900		WRITE(LIST,46)((JB(I,L),I=1,6),L=J,J+ID)
16000	46	FORMAT(3(2X2A1,4A5))
16100		WRITE(LIST,46)((JC(I,L),I=1,6),L=J,J+ID)
16200		IF(Y.NE.'Y')GO TO 45
16300		WRITE(LIST,48)((JD(I,L),I=1,6),L=J,J+ID)
16400	48	FORMAT(/4X5A1,2(19X5A1))
16500	45	CONTINUE
16600		IF(T.EQ.'L')CALL EXIT
16700		U=1
16800		GO TO 8
16900		END
17000	
17100		FUNCTION LN(M)
17200		MX=100000000
17300		LN=0
17400		DO 1 K=1,5
17500		LN=LN+NU(K,M,MX)
17600	1	MX=MX/100
17700		RETURN
17800		END
17900	
18000		FUNCTION NU(K,M,MX)
18100		COMMON JA(10,200)
18200		NU=(1-('A'-JA(K,M))/536870912)*MX
18300		RETURN
18400		END